Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/PBLIB1/UNITS/OBJINFO.INC

Text File | 1994-04-30 | 8KB | 341 lines

{SECTION INFO_object }
CONSTRUCTOR INFO_object.init(max : integer);
var l : longint;
    i : integer;
     begin
     sepchar := ';';   { separator between key and data }
     sortmode := true; { ascending }
     sorted  := false; { not sorted yet }
     infoheader.init;
     keystring.init(max);
     keyvalue.init(max);
     end;


procedure INFO_object.setsepchar(sep : char);
     begin
     sepchar := sep;   { separator between key and data }
     end;


{
procedure INFO_object.dispose;
var l : longint;
    i : integer;
    ok : boolean;
     begin
     keyvalue.done;
     keystring.done;
     infoheader.dispose;
     sorted := false;
     end; }


procedure INFO_object.done;   {conformity 2/94}
var l : longint;
    i : integer;
    ok : boolean;
     begin
     keyvalue.done;
     keystring.done;
     infoheader.dispose;
     sorted := false;
     end;


procedure INFO_object.clear;
var l : longint;
    i : integer;
    ok : boolean;
     begin
     keystring.clear;
     keyvalue.clear;
     sorted := false;
     end;



Function  INFO_object.Count : integer;
     begin
     Count := keystring.count;
     end;


Function  INFO_object.ArrayMaxSize : integer;
     begin
     ArrayMaxSize := keystring.ArrayMaxSize;
     end;


Function  INFO_object.storeheader (s : string) : boolean;
     begin
     storeheader := infoheader.store(s);
     end;


Function  INFO_object.fetchheader : string;
     begin
     fetchheader := infoheader.fetch;
     end;


Function INFO_object.store(ks,kv : string) : boolean;
var OK : boolean;
    n  : integer;
     begin
     n := keystring.find(ks);
     if n > 0 then
          begin
          OK := keystring.storeN(n,UpCaseStr(ks));
          if OK then OK := keyvalue.storeN(n,kv);
          end
     else begin
          OK := keystring.append(UpCaseStr(ks));
          if OK then OK := keyvalue.append(kv);
          end;
     store := OK;
     sorted := false;
     end;


Function INFO_object.fetch(ks : string) : string;
var n : integer;
    s : string;
     begin
     s := '';
     n := keystring.find(ks);
     if n > 0 then s := keyvalue.fetchN(n);
     fetch := s;
     end;


Function  INFO_object.FetchString(ks : string) : string;
    begin
    FetchString := INFO_object.fetch(ks);
    end;


Function  INFO_object.FetchInteger(ks : string) : integer;
    begin
    FetchInteger := StrInt(INFO_object.fetch(ks));
    end;


Function  INFO_object.FetchLongInt(ks : string) : longint;
    begin
    FetchLongInt := StrLong(INFO_object.fetch(ks));
    end;


Function  INFO_object.Fetchreal(ks : string) : real;
    begin
    Fetchreal := StrReal(INFO_object.fetch(ks));
    end;


Function  INFO_object.FetchBoolean(ks : string) : boolean;
var result : boolean;
    s      : string;
    begin
    result := false;
    s := UpCaseStr(INFO_object.fetch(ks));
    if s = 'YES' then result := true;
    FetchBoolean := result;
    end;


Function INFO_object.fetchkeyn(n : integer) : string;
var s : string;
     begin
     s := '';
     if n > 0 then s := keystring.fetchN(n);
     fetchkeyn := s;
     end;


Function INFO_object.fetchn(n : integer) : string;
var s : string;
     begin
     s := '';
     if n > 0 then s := keyvalue.fetchN(n);
     fetchn := s;
     end;


Function  INFO_object.search (ks : string; mode : byte) : string;
{ returns key string matching request }
var n : integer;
    s : string;
     begin
     s := '';
     n := keystring.search(ks,mode);
     if n > 0 then s := keystring.fetchN(n);
     search := s;
     end;



Procedure INFO_object.dump;
var i  : integer;
     begin
     writeln('Info object dump  ', keystring.count);
     if keystring.count < 1 then exit;
     for i := 1 to keystring.count do
          begin
          writeln(i:4,' [',keystring.fetchN(i),']  [',
                           keyvalue.fetchN(i),']');
          end;
     writeln('');
     end;


Procedure INFO_object.save(fname : string);
var i  : integer;
    OK : boolean;
    TEXTF : TFILE_object;
     begin
     if keystring.count < 1 then exit;
     TEXTF.init(fname,true);
     TEXTF.append('*'+infoheader.fetch);
     for i := 1 to keystring.count do
         begin
         TEXTF.append(keystring.fetchN(i)+sepchar+keyvalue.fetchN(i));
         end;
     TEXTF.done;
     end;


Procedure INFO_object.load(fname : string);
var s,s1 : string;
    i : integer;
    OK : boolean;
    TEXTF : TFILE_object;
     begin
     TEXTF.init(fname,false);
     while ok and TEXTF.fetchnext(s) do
         begin
         if (INFO_object.count = 0) and (s[1] = '*') then
              begin
              delete(s,1,1);
              ok := infoheader.store(s);
              end
         else begin
              s1 := '';
              i := pos(sepchar,s);
              if i > 1 then
                   begin
                   s1 := s;
                   delete(s1,1,i);
                   s := leftstr(s,i-1);
                   end;
              ok := INFO_object.store(s,s1);
              end;
         end;
     TEXTF.done;
     end;

{$R-}

Procedure INFO_object.swap(i,j : integer);
var OK : boolean;
var s  : string;
    nd : integer;
     begin
     s  := keystring.fetchN(i);
     OK := keystring.storeN(i,keystring.fetchN(j));
     OK := keystring.storeN(j,s);
     s  := keyvalue.fetchN(i);
     OK := keyvalue.storeN(i,keyvalue.fetchN(j));
     OK := keyvalue.storeN(j,s);
     end;


Function needswapping(sortflag : boolean; s1,s2 : string) : boolean;
var result : boolean;
     begin
     result := false;
     if          sortflag and (s1 < s2) then result := true
     else if not sortflag and (s1 > s2) then result := true;
     needswapping := result;
     end;


procedure INFO_object.setsortmode(flag : boolean);
     begin
     sortmode := flag; { true := ascending, false = descending }
     end;


procedure INFO_object.sort;
var Gap,I,J,N : integer;
    s1,s2      : string;
     begin
     N   := INFO_object.count;
     Gap := N div 2;
     while (Gap > 0) do
         begin
         I := Gap;
         while (I < N) do
              begin
              J := I - Gap;
              s1 := UpCaseStr(keystring.fetchN(J+Gap+1));
              s2 := UpCaseStr(keystring.fetchN(J+1));
              while (J >= 0) and needswapping(sortmode,s1,s2) do
                   begin
                   INFO_object.swap(J+1,J+Gap+1);
                   dec(J,Gap);
                   s1 := UpCaseStr(keystring.fetchN(J+Gap+1));
                   s2 := UpCaseStr(keystring.fetchN(J+1));
                   end;
              inc(I);
              end;
         Gap:=Gap div 2;
         end;
     sorted := true;
     end;

{$R+}
{SECTION .LOOKUP_object }
Procedure LOOKUP_object.init(num : integer);
     begin
     hold.init(num);
     end;


Procedure LOOKUP_object.append(tag,str : string);
var s : string;
     begin
     s := tag;   trim(s);   s := UpCaseStr(s);
     hold.store(s,str);
     end;


Function  LOOKUP_object.lookup (tag : string) : string;
var s : string;
    i : integer;
     begin
     s := tag;   trim(s);   s := UpCaseStr(s);
     lookup := hold.fetchstring(s);
     end;


Function  LOOKUP_object.fetchN(n : integer) : string;
     begin
     fetchN := hold.fetchN(n);
     end;


Procedure LOOKUP_object.dump;
     begin
     hold.dump;
     end;


Procedure LOOKUP_object.done;
     begin
     hold.done;
     end;